package JasPerl::Compiler::JspCompiler;

use strict;
use warnings;

use JasPerl::Compiler::FunctionMapper;
use JasPerl::Compiler::NameMangler;
use JasPerl::Compiler::PageWriter;
use JasPerl::Compiler::Util qw{ abs_path escape quote };
use JasPerl::EL::ExpressionEvaluator;
use JasPerl::JspWriter;

use Carp;
use Module::Load;

my @INVOKE_INIT = (
    'my $fragment = shift;',
    'my $context = $fragment->get_jsp_context();',
    'my $parent = $fragment->get_parent();',
    'my $out = $context->get_out();'
);

my @PAGE_MODULES = qw{ JasPerl::Exceptions JasPerl::JspFactory JasPerl::TagExt::JspFragment };

my %PAGE_DIRECTIVE_ATTR = (
    'language' => sub {
        carp "unsupported page directive attribute 'language'";
    },

    'extends' => sub {
        carp "unsupported page directive attribute 'extends'";
    },

    'import' => sub {
        carp "unsupported page directive attribute 'import'";
    },

    'session' => sub {
        my ($self, $value) = @_;
        die "invalid page directive attribute 'session': $value"
            unless $value =~ /^(true|false)$/;
        $self->{page}->{session} = $value eq 'true' ? 1 : 0;
    },

    'buffer' => sub {
        my ($self, $value) = @_;
        die "invalid page directive attribute 'buffer': $value"
            unless $value =~ /^(?:(\d+)\s*kb|none)$/;
        $self->{page}->{buffer} = ($1 ? $1 * 1024 : 0);
    },

    'autoFlush' => sub {
        my ($self, $value) = @_;
        die "invalid page directive attribute 'autoFlush': $value"
            unless $value =~ /^(true|false)$/;
        $self->{page}->{autoflush} = $value eq 'true' ? 1 : 0;
    },

    'isThreadSafe' => sub {
        carp "deprecated page directive attribute 'isThreadSafe'";
    },

    'info' => sub {
        my ($self, $value) = @_;
        $self->{page}->{info} = $value;
    },

    'isErrorPage' => sub {
        carp "ignoring page directive attribute 'isErrorPage'";
    },

    'errorPage' => sub {
        my ($self, $value) = @_;
        $self->{page}->{errpage} = $value;
    },

    'contentType' => sub {
        my ($self, $value) = @_;
        # TODO: check charset
        $self->{page}->{content_type} = $value;
    },

    'pageEncoding' => sub {
        my ($self, $value) = @_;
        # TODO: pageEncoding per translation unit
        $self->{page}->{charset} = $value;
    },

    'isELIgnored' => sub {
        my ($self, $value) = @_;
        die "invalid page directive attribute 'isELIgnored': $value"
            unless $value =~ /^(true|false)$/;
        # TODO: use per page or translation unit
    }
);

my %DIRECTIVE = (
    'page' => sub {
        my ($self, %attr) = @_;
        foreach my $name (keys %attr) {
            if (my $method = $PAGE_DIRECTIVE_ATTR{$name}) {
                $self->$method($attr{$name});
            } else {
                # TODO: fatal
                carp "unknown page directive attribute '$name'";
            }
        }
    },

    'taglib' => sub {
        my ($self, %attr) = @_;
        die "tagdir not supported\n" if exists $attr{tagdir};
        $self->{taglibs}->{$attr{prefix}} = $self->context->get_taglib($attr{uri});
    },

    'include' => sub {
        my ($self, %attr) = @_;
        my $path = abs_path($attr{file}, $self->{path}->[-1]);
        my $parser = $self->parser;

        push @{$self->{path}}, $path;
        $parser->parse($self->context->get_real_path($path));
        pop @{$self->{path}};
    }
);

my %ACTIONS = (
    useBean => [
        sub {
            my ($self, %attr) = @_;
            $self->{modules}->{'JasPerl::Util::Beans'}++;
            my $id = $attr{id};
            my $class = $attr{class};
            my $scope = $attr{scope} || JasPerl::PageContext::PAGE_SCOPE;
            $self->_output("my \$$id = JasPerl::Util::Beans->instantiate('$class');");
            $self->_output("\$context->set_attribute('$id', \$$id, '$scope');");
        },
        sub {
        }
    ],
    setProperty => [
        sub {
            my ($self, %attr) = @_;
            $self->{modules}->{'JasPerl::Util::Beans'}++;
        },
        sub {
        }
    ],
    getProperty => [
        sub {
            my ($self, %attr) = @_;
            $self->{modules}->{'JasPerl::Util::Beans'}++;
            my $name = $attr{name};
            my $property = $attr{property};
            $self->_output("\$out->print(JasPerl::Util::Beans->get_property(\$context->get_attribute('$name'), '$property'));");

        },
        sub {
        }
    ],
    include => [
        sub {
            my ($self, %attr) = @_;
            my ($page, $flush) = @attr{qw(page flush)};
            $flush = JasPerl::Util::Boolean->from($flush) ? 1 : 0;
            $self->_output("\$context->include('$page', $flush);");
        },
        sub {
        }
    ],
    forward => [
        sub {
            my ($self, %attr) = @_;
            my ($page) = @attr{qw(page)};
            $self->_output("\$context->forward('$page');");
        },
        sub {
        }
    ]
);

sub new {
    my ($class, $context) = @_;

    my $self = {
        base => 'JasPerl::JspPage',
        eval => JasPerl::EL::ExpressionEvaluator->new(composite => 1),
        expr => { },
        context => $context,
        indent => 4,
        main => [ ],
        mangler => JasPerl::Compiler::NameMangler->new,
        modules => { map { $_ => 1 } @PAGE_MODULES },
        page => { },
        subs => { },
        taglibs => { },
        tags => [ ]
    };

    $self->{fnmapper} = JasPerl::Compiler::FunctionMapper->new($self->{taglibs});

    bless $self, $class;
}

sub context {
    return $_[0]->{context};
}

sub parser {
    return $_[0]->{context}->get_parser($_[0]);
}

sub mangler {
    return $_[0]->{mangler};
}

sub out {
    return $_[0]->{out};
}

sub compile {
    my ($self, $path) = @_;
    my $file = $self->context->get_module_path($path);
    print STDERR "*** compile $path to $file\n";
    $self->{out} = JasPerl::Compiler::PageWriter->new($file);
    $self->{path} = [ $path ];

    my $parser = $self->parser;

    $self->start_module($self->context->get_module_name($path));
    $self->start_page($path);
    $parser->parse($self->context->get_real_path($path));
    $self->end_page($path);
    $self->end_module($self->context->get_module_name($path));
}

sub start_module {
    my ($self, $package) = @_;
    $self->out->println("package $package;");
}

sub end_module {
    my ($self, $package) = @_;
    $self->out->println();
    $self->out->println('1;');
}

sub start_page {
    my ($self, $path) = @_;
}

sub end_page {
    my ($self, $path) = @_;
    my $page = $self->{page};
    my $out = $self->{out};

    if (my @fnmodules = $self->{fnmapper}->modules()) {
        print STDERR "*** modules: @fnmodules\n";
        $self->{modules}->{$_} = 1 foreach @fnmodules;
    }

    $out->println("use base '$self->{base}';");
    $out->println();
    $out->println("use $_;") foreach sort keys %{$self->{modules}};
    $out->println();

    foreach my $expr (sort keys %{$self->{expr}}) {
        $out->println('my ', $self->{expr}->{$expr}->dump($expr));
    }

    if ($page->{info}) {
        $self->{subs}->{info} = [ "return " . quote($page->{info}) . ";" ];
    }

    foreach my $sub (sort keys %{$self->{subs}}) {
        $out->printil("sub $sub {");
        $out->push_indent($self->{indent});
        $out->printil($_) foreach @{$self->{subs}->{$sub}};
        $out->pop_indent();
        $out->printil("}");
        $out->println();
    }

    # main
    $out->printil("sub _jsp_main {");
    $out->push_indent($self->{indent});
    $out->printil('my ($self, $context, $out) = @_;');
    $out->printil($_) foreach @{$self->{main}};
    $out->pop_indent();
    $out->printil("}");
    $out->println();

    my $content = $page->{'content_type'} || 'text/html';
    my $charset = $page->{'charset'} || $self->context->get_page_encoding($path);
    my $errpage = exists $page->{'errpage'} ? quote($self->{page}->{'errpage'}) : 'undef';
    my $session = exists $page->{'session'} ? $page->{'session'} : 'undef'; # TODO: default?
    #warn "session=$session";
    # FIXME: default buffer
    my $buffer = exists $page->{'buffer'} ? $page->{'buffer'} : 8192;
    my $autoflush = exists $page->{'autoflush'} ? $page->{'autoflush'} : 1;

    $out->printil('sub _jsp_service {');
    $out->push_indent($self->{indent});
    $out->printil('my ($self, $request, $response) = @_;');
    $out->printil("\$response->set_content_type(\"$content; charset=$charset\");");
    $out->println();
    $out->printil('my $factory = JasPerl::JspFactory->get_default_factory();');
    $out->printil("my \$context = \$factory->get_page_context(\$self, \$request, \$response, $errpage, $session, $buffer, $autoflush);");
    $out->println();
    $out->printil('eval {');
    $out->push_indent($self->{indent});
    $out->printil('$self->_jsp_main($context, $context->get_out());');
    $out->pop_indent();
    $out->printil('};');
    $out->printil('if (my $e = JasPerl::Util::Throwable->caught()) {');
    $out->push_indent($self->{indent});
    $out->printil('$context->handle_page_exception($e) unless $e->isa("JasPerl::SkipPageException");');
    $out->pop_indent();
    $out->printil('} elsif ($@) {');
    $out->push_indent($self->{indent});
    $out->printil('$context->handle_page_exception(JasPerl::Util::Throwable->from($@));');
    $out->pop_indent();
    $out->printil('}');;
    $out->println();
    $out->printil('$factory->release_page_context($context);');
    $out->pop_indent();
    $out->printil('}');
}

sub start_action {
#    print STDERR "start_tag: @_\n";
    my ($self, $prefix, $name, %attr) = @_;
    return $self->start_standard_action($prefix, $name, %attr) if $prefix eq 'jsp';
    my $taglib = $self->{taglibs}->{$prefix}
        or die "unknown prefix: $prefix\n";
    my $package = $self->{taglibs}->{$prefix}->tag($name)
        or die "unknown tag: ${prefix}:${name}\n";
    $self->{modules}->{$package}++;

    my $var = '$' . $self->mangler->mangle_tag("$prefix:$name");
    $self->_output("my $var = ${package}->new;");
    $self->_output("${var}->set_jsp_context(\$context);");
    $self->_output("${var}->set_parent(\$parent);") if @{$self->{tags}};

    foreach (keys %attr) {
        my $setter = $self->mangler->mangle("set_${_}");
        if ($attr{$_} =~ /\${/) {
            my $name = $self->mangler->mangle_expr('expr');
            my $expr = $self->{eval}->parse($attr{$_}, $self->{fnmapper});
            $self->{modules}->{ref $expr}++;
            $self->{expr}->{$name} = $expr;
            # TODO: check if setter exists
            $self->_output("${var}->${setter}(\$${name}->eval(\$context->get_variable_resolver));");
        } else {
            # TODO: check if exists
            $self->_output("${var}->${setter}(", quote($attr{$_}), ');');
        }
    }

    push @{$self->{tags}}, { var => $var, body => [ ] };
}

sub end_action {
#    print STDERR "end_tag: @_\n";
    my ($self, $prefix, $name) = @_;
    return $self->end_standard_action($prefix, $name) if $prefix eq 'jsp';
    my $tag = pop @{$self->{tags}};
    my $var = $tag->{var};
    confess "mismatched end tag: $prefix:$name\n" unless $var;
    if (my @body = @{$tag->{body}}) {
        my $sub = $self->mangler->mangle_method("invoke");
        die "internal error" if exists $self->{subs}->{$sub};
        $self->{subs}->{$sub} = [ @INVOKE_INIT, @body ];
        $self->_output("$var->set_jsp_body(JasPerl::TagExt::JspFragment->new(\\&$sub, \$context, $var));");
    }
    $self->_output("$var->do_tag();");
}

sub start_standard_action {
    my ($self, $prefix, $name, %attr) = @_;
    if (my $method = $ACTIONS{$name}->[0]) {
        $self->$method(%attr);
    } else {
        die "Invalid standard action: $name";
    }
}

sub end_standard_action {
    my ($self, $prefix, $name) = @_;
    if (my $method = $ACTIONS{$name}->[1]) {
        $self->$method();
    } else {
        die "Invalid standard action: $name";
    }
}

sub directive {
    my $self = shift;
    my $name = shift;

    if (my $method = $DIRECTIVE{$name}) {
        $self->$method(@_);
    } else {
        die "Invalid directive: $name";
    }
}

sub expression {
    my ($self, $text) = @_;
    my $name = $self->mangler->mangle_expr('expr');
    my $expr = $self->{eval}->parse($text, $self->{fnmapper});
    $self->{modules}->{ref $expr}++;
    $self->{expr}->{$name} = $expr;
    $self->_output('$out->print($', $name, '->eval($context->get_variable_resolver));');
}

sub characters {
    my ($self, $text) = @_;
    while ($text =~ /([^[:cntrl:]]*)([[:cntrl:]]*)?/sg) {
        if (length $1) {
            my @stmt = ('$out->print(', quote($1));
            push @stmt, ', ', escape($2) if $2;
            push @stmt, ');';

            $self->_output(@stmt);
        } elsif (length $2) {
            $self->_output('$out->print(', escape($2), ');');
        }
    }
}

sub _output {
    my $self = shift;
    my $line = join('', @_);

    if (@{$self->{tags}}) {
        push @{$self->{tags}->[-1]->{body}}, $line;
    } else {
        push @{$self->{main}}, $line;
    }
}

1;

__END__
